home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / efs / efs-hell.el.z / efs-hell.el
Encoding:
Text File  |  1998-05-21  |  6.5 KB  |  186 lines
  1. ;; -*-Emacs-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;
  4. ;; File:         efs-hell.el
  5. ;; Release:      $efs release: 1.15 $
  6. ;; Version:      #Revision: 1.1 $
  7. ;; RCS:          
  8. ;; Description:  Hellsoft FTP server support for efs
  9. ;; Author:       Sandy Rutherford <sandy@ibm550.sissa.it>
  10. ;; Created:      Tue May 25 02:31:37 1993 by sandy on ibm550
  11. ;; Modified:     Sun Nov 27 18:32:27 1994 by sandy on gandalf
  12. ;; Language:     Emacs-Lisp
  13. ;;
  14. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  15.  
  16. ;;; This file is part of efs. See efs.el for copyright
  17. ;;; (it's copylefted) and warrranty (there isn't one) information.
  18.  
  19. (provide 'efs-hell)
  20. (require 'efs)
  21.  
  22. (defconst efs-hell-version
  23.   (concat (substring "$efs release: 1.15 $" 14 -2)
  24.       "/"
  25.       (substring "#Revision: 1.1 $" 11 -2)))
  26.  
  27. ;;;; --------------------------------------------------------------
  28. ;;;; Hellsoft FTP server support for efs
  29. ;;;; --------------------------------------------------------------
  30.  
  31. ;;; The hellsoft FTP server runs on DOS PC's and Macs. The hellsoft
  32. ;;; support here probably won't work for Macs. If enough people need it
  33. ;;; the Mac support _might_ be fixed.
  34.  
  35. ;;; Works for "novell FTP Server for NW 3.11 (v1.8), (c) by HellSoft."
  36.  
  37. ;; Hellsoft uses unix path syntax. However, we shouldn't append a "."
  38. ;; to directories, because if foobar is a plain file, then
  39. ;; dir foobar/ will not give a listing (which is correct), but
  40. ;; dir foobar/. will give a one-line listing (which is a little strange).
  41.  
  42. (efs-defun efs-fix-dir-path hell (dir-path)
  43.   dir-path)
  44.  
  45. ;; Hellsoft returns PWD output in upper case, whereas dir listings are
  46. ;; in lower case. To avoid confusion, downcase pwd output.
  47.  
  48. (efs-defun efs-send-pwd hell (host user &optional xpwd)
  49.   ;; Returns ( DIR . LINE ), where DIR is either the current directory, or
  50.   ;; nil if this couldn't be found. LINE is the line of output from the
  51.   ;; FTP server. Since the hellsoft server returns pwd output in uppercase, we
  52.   ;; downcase it.
  53.   (let ((result (efs-send-pwd 'unix host user xpwd)))
  54.     (if (car result)
  55.     (setcar result (downcase (car result))))
  56.     result))
  57.  
  58. (defconst efs-hell-date-and-time-regexp
  59.   (concat
  60.    " \\([0-9]+\\) \\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct"
  61.    "\\|Nov\\|Dec\\) [0-3][0-9] "
  62.    "\\([012][0-9]:[0-5][0-9]\\| [12][019][0-9][0-9]\\) "))
  63. ;; The end of this regexp corresponds to the start of a filename.
  64.  
  65. (defmacro efs-hell-parse-file-line ()
  66.   ;; Returns ( FILENAME DIR-P SIZE ) from the current line
  67.   ;; of a hellsoft listing. Assumes that the point is at the beginning
  68.   ;; of the line.
  69.   (` (let ((eol (save-excursion (end-of-line) (point)))
  70.        (dir-p (= (following-char) ?d)))
  71.        (if (re-search-forward efs-hell-date-and-time-regexp eol t)
  72.        (list (buffer-substring (point) (progn (end-of-line) (point)))
  73.          dir-p
  74.          (string-to-int (buffer-substring (match-beginning 1)
  75.                           (match-end 1))))))))
  76.        
  77. (efs-defun efs-parse-listing hell
  78.   (host user dir path &optional switches)
  79.   ;; Parse the current buffer which is assumed to be a listing from
  80.   ;; a Hellsoft FTP server.
  81.   ;; HOST = remote host name
  82.   ;; USER = remote user name
  83.   ;; DIR = remote directory as a full remote path
  84.   ;; PATH = directory in full efs-path syntax
  85.   (goto-char (point-min))
  86.   (efs-save-match-data
  87.     (if (re-search-forward efs-hell-date-and-time-regexp nil t)
  88.     (let ((tbl (efs-make-hashtable))
  89.           file-info)
  90.       (beginning-of-line)
  91.       (while (setq file-info (efs-hell-parse-file-line))
  92.         (efs-put-hash-entry (car file-info) (cdr file-info) tbl)
  93.         (forward-line 1))
  94.       (efs-put-hash-entry "." '(t) tbl)
  95.       (efs-put-hash-entry ".." '(t) tbl)
  96.       tbl)
  97.       (if (not (string-match (efs-internal-file-name-nondirectory
  98.                   (efs-internal-directory-file-name dir)) "\\."))
  99.       ;; It's an empty dir
  100.       (let ((tbl (efs-make-hashtable)))
  101.         (efs-put-hash-entry "." '(t) tbl)
  102.         (efs-put-hash-entry ".." '(t) tbl)
  103.         tbl)))))
  104.  
  105.  
  106. (efs-defun efs-allow-child-lookup hell (host user dir file)
  107.   ;; Returns t if FILE in directory DIR could possibly be a subdir
  108.   ;; according to its file-name syntax, and therefore a child listing should
  109.   ;; be attempted.
  110.   ;; Subdirs in DOS can't have an extension.
  111.   (not (string-match "\\." file)))
  112.  
  113. ;;; Tree Dired
  114.  
  115. (defconst efs-dired-hell-re-exe
  116.   "^[^\n]+\\.exe$")
  117.  
  118. (or (assq 'hell efs-dired-re-exe-alist)
  119.     (setq efs-dired-re-exe-alist
  120.       (cons (cons 'hell  efs-dired-hell-re-exe)
  121.         efs-dired-re-exe-alist)))
  122.  
  123. (defconst efs-dired-hell-re-dir
  124.   "^. [ \t]*d")
  125.  
  126. (or (assq 'hell efs-dired-re-dir-alist)
  127.     (setq efs-dired-re-dir-alist
  128.       (cons (cons 'hell  efs-dired-hell-re-dir)
  129.         efs-dired-re-dir-alist)))
  130.  
  131. (efs-defun efs-dired-manual-move-to-filename hell
  132.   (&optional raise-error bol eol)
  133.   ;; In dired, move to the first char of filename on this line, where
  134.   ;; line can be delimited by either \r or \n.
  135.   ;; Returns (point) or nil if raise-error is nil and there is no
  136.   ;; filename on this line. In the later case, leaves the point at the
  137.   ;; beginning of the line.
  138.   ;; This version is for the Hellsoft FTP server.
  139.   (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
  140.   (let (case-fold-search)
  141.     (if bol
  142.     (goto-char bol)
  143.       (skip-chars-backward "^\n\r"))
  144.     (if (re-search-forward efs-hell-date-and-time-regexp eol t)
  145.     (point)
  146.       (and raise-error (error "No file on this line")))))
  147.  
  148. (efs-defun efs-dired-manual-move-to-end-of-filename hell
  149.   (&optional no-error bol eol)
  150.   ;; Assumes point is at the beginning of filename.
  151.   ;; So, it should be called only after (dired-move-to-filename t)
  152.   ;; On failure signals an error, or returns nil.
  153.   ;; This is the Hellsoft FTP server version.
  154.   (let ((opoint (point)))
  155.     (and selective-display
  156.      (null no-error)
  157.      (eq (char-after
  158.           (1- (or bol (save-excursion
  159.                 (skip-chars-backward "^\r\n")
  160.                 (point)))))
  161.          ?\r)
  162.      ;; File is hidden or omitted.
  163.      (cond
  164.       ((dired-subdir-hidden-p (dired-current-directory))
  165.        (error
  166.         (substitute-command-keys
  167.          "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
  168.       ((error
  169.         (substitute-command-keys
  170.          "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
  171.          )))))
  172.     (skip-chars-forward "-_+=a-zA-Z0-9.$~")
  173.     (if (or (= opoint (point)) (not (memq (following-char) '(?\n ?\r))))
  174.     (if no-error
  175.         nil
  176.       (error "No file on this line"))
  177.       (point))))
  178.  
  179. (efs-defun efs-dired-insert-headerline hell (dir)
  180.   ;; Insert a blank line for aesthetics
  181.   (insert "\n")
  182.   (forward-char -1)
  183.   (efs-real-dired-insert-headerline dir))
  184.  
  185. ;;; end of efs-hell.el
  186.